home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #123 (1991-06)(Rhein-Sieg-Soft).zip / Franz PD Disk #123 (1991-06)(Rhein-Sieg-Soft).adf / AdressDat_V1.3 / AdressDat_V1.3 < prev    next >
Text File  |  1991-06-05  |  19KB  |  607 lines
  1. REM  Dieses Programm ist Public Domain.
  2.  
  3. Main:
  4.   CLEAR
  5.   GOSUB Init
  6.   GOSUB Zeit
  7.   GOSUB Bildaufbau
  8.   DIM Daten$(6)
  9.   GOSUB Warten
  10.   OPEN "AdressDat.config" FOR OUTPUT AS 2
  11.   PRINT #2,Feldzaehler
  12.   CLOSE 1,2
  13.   LIBRARY CLOSE
  14.   WINDOW CLOSE 2
  15.   SCREEN CLOSE 1
  16.   MENU RESET
  17. END
  18.  
  19. Init:
  20.   DEFINT a-z
  21.   LIBRARY "graphics.library"
  22.   LIBRARY "intuition.library"
  23.   WindowTitle$="AdressDat V1.3 - Public Domain" +SPACE$(41)
  24.   SCREEN 1,640,256,2,2
  25.   WINDOW 2," ",,0,1
  26.   wptr&=WINDOW(7)
  27.   rp&=WINDOW(8)
  28.   PALETTE 0,0,0,0
  29.   PALETTE 1,13/15,13/15,8/15
  30.   PALETTE 2,6/15,6/15,9/15
  31.   PALETTE 3,1,0,0
  32.   MENU 1,0,1,"" : MENU 2,0,1,"" : MENU 3,0,1,"" : MENU 4,0,1,""
  33.   DIM DatFeld$(6)
  34.   OPEN "Adressen" AS 1 LEN=227
  35.   FIELD #1,30 AS DatFeld$(0),30 AS DatFeld$(1),20 AS DatFeld$(2),12 AS DatFeld$(3),45 AS DatFeld$(4),45 AS DatFeld$(5),45 AS DatFeld$(6)
  36.   DIM Laenge(6)
  37.   RESTORE Laengen
  38.   FOR i=0 TO 6
  39.     READ Laenge(i)
  40.   NEXT
  41.   OPEN "AdressDat.config" FOR APPEND AS 2
  42.   IF LOF(2)=0 THEN
  43.     CLOSE 2
  44.     OPEN "AdressDat.config" FOR OUTPUT AS 2
  45.     PRINT #2,1
  46.   END IF
  47.   CLOSE 2
  48.   OPEN "AdressDat.config" FOR INPUT AS 2
  49.   INPUT #2,Feldzaehler
  50.   CLOSE 2
  51. RETURN
  52.  
  53. Bildaufbau:
  54.   DIM x(3),y(9),Feld$(4)
  55.   RESTORE MaskeX
  56.   FOR i=0 TO 3 : READ x(i) : NEXT
  57.   RESTORE MaskeY
  58.   FOR i=0 TO 9 : READ y(i) : NEXT
  59.   RESTORE Namen
  60.   FOR i=0 TO 4 : READ Feld$(i) : NEXT
  61.   FOR x1=0 TO 3 STEP 2
  62.     x2=x1+1
  63.     FOR y1=0 TO 9 STEP 2
  64.       y2=y1+1
  65.       CALL SetAPen& (rp&,3)
  66.       CALL RectFill& (rp&,x(x1)-1,y(y1)-1,x(x2)+1,y(y2)+1)
  67.       CALL SetAPen& (rp&,0)
  68.       CALL RectFill& (rp&,x(x1),y(y1),x(x2),y(y2))
  69.     NEXT
  70.   NEXT
  71.   CALL SetAPen& (rp&,1) : CALL SetBPen& (rp&,0)
  72.   CALL SetDrMd& (rp&,0)
  73.   FOR i=0 TO 4
  74.     j=i*2
  75.     CALL Move& (rp&,x(0)+4,y(j)+10)
  76.     CALL Text& (rp&,SADD(Feld$(i)+CHR$(0)),LEN(Feld$(i)))
  77.   NEXT
  78. RETURN
  79.  
  80. Warten:
  81.   Aus=0
  82.   WHILE NOT Aus
  83.     CALL SetAPen& (rp&,0)
  84.     CALL RectFill& (rp&,0,0,640,30)
  85.     CALL RectFill& (rp&,0,132,640,246)
  86.     Outline "AdressDat          by Jakob Tschuschke",1,0,-1,14,rp&
  87.     Shadow "Adressen:",1,2,30,142,rp&
  88.     Shadow "(E)ingeben                  (A)endern",1,2,-1,154,rp&
  89.     Shadow "(L)esen                      (S)uchen",1,2,-1,166,rp&
  90.     Shadow "(Q)uit",1,2,-1,210,rp&
  91.     Taste "EALSQ",Antwort$
  92.     IF Antwort$="E" THEN GOSUB Eingabe
  93.     IF Antwort$="A" THEN GOSUB Aendern
  94.     IF Antwort$="L" THEN GOSUB Lesen
  95.     IF Antwort$="S" THEN GOSUB Suchen
  96.     IF Antwort$="Q" THEN GOSUB Quit
  97.   WEND
  98.   TIMER OFF
  99. RETURN
  100.  
  101. Eingabe:
  102.   Zurueck=0
  103.   WHILE NOT Zurueck
  104.     CALL SetAPen& (rp&,0)
  105.     CALL RectFill& (rp&,0,0,640,30)
  106.     CALL RectFill& (rp&,0,132,640,256)
  107.     x1=2 : x2=3
  108.     FOR y1=0 TO 9 STEP 2
  109.       y2=y1+1
  110.       CALL RectFill& (rp&,x(x1),y(y1),x(x2),y(y2))
  111.     NEXT
  112.     Shadow  "Datensatznummer : "+STR$(Feldzaehler),1,2,3,27,rp&
  113.     Outline "AdressDat  -  Adressen eingeben:",1,0,-1,14,rp&
  114.     CALL SetAPen& (rp&,1)
  115.     z=0
  116.     FOR i=0 TO 4
  117.       CALL SetDrMd& (rp&,2)
  118.       CALL RectFill& (rp&,x(0)-1,y(z),x(1)+1,y(z+1))
  119.       j=i*2
  120.       CALL SetDrMd& (rp&,1)
  121.       xEdit Daten$(i),Laenge(i),x(2)+4,y(j)+10,rp&
  122.       IF i <= 3 THEN
  123.         CALL SetDrMd& (rp&,2)
  124.         CALL RectFill& (rp&,x(0)-1,y(z),x(1)+1,y(z+1))
  125.         z=z+2
  126.       END IF
  127.     NEXT
  128.     CALL SetDrMd& (rp&,1)
  129.     xEdit Daten$(5),Laenge(5),x(2)+4,y(8)+19,rp&
  130.     xEdit Daten$(6),Laenge(6),x(2)+4,y(8)+28,rp&
  131.     CALL SetDrMd& (rp&,2)
  132.     CALL RectFill& (rp&,x(0)-1,y(z),x(1)+1,y(z+1))
  133.     CALL SetDrMd& (rp&,0)
  134.     IF Daten$(0)="" THEN  'Wenn der Name keine Zeichen enthält,
  135.       Zurueck=-1          'dann verlassen
  136.     ELSE
  137.       Shadow "Abspeichen (j/n) ?",1,2,-1,151,rp&
  138.       Taste "JN"+CHR$(13),Antwort$
  139.       IF Antwort$="J" OR Antwort$=CHR$(13) THEN
  140.         Speichernummer=Feldzaehler
  141.         GOSUB Speichern
  142.         Feldzaehler=Feldzaehler+1
  143.       END IF
  144.     END IF
  145.   WEND
  146. RETURN
  147.  
  148. Lesen:
  149.   Lesenummer=0
  150.   Zurueck=0
  151.   CALL SetAPen& (rp&,0)
  152.   CALL RectFill& (rp&,0,0,640,30)
  153.   CALL RectFill& (rp&,0,132,640,256)
  154.   Outline "AdressDat - Adressen lesen",1,0,-1,14,rp&
  155.   Shadow "<Cursor left> --->  1 Adresse zurück    <Cursor right> --->  1 Adresse  vor",1,2,3,160,rp&
  156.   Shadow "<Cursor up>   ---> 10 Adressen zurück   <Cursor down>  ---> 10 Adressen vor",1,2,3,172,rp&
  157.   Shadow "<Backspace>   ---> Erste Adresse        <TAB>          --->  Letzte Adresse",1,2,3,184,rp&
  158.   Shadow "<Return>      ---> Direkter Sprung      <ESC>          --->            Ende",1,2,3,196,rp&      
  159.   GOSUB Nummerneingabe
  160.   Lesenummer$=Nummer$
  161.   WHILE NOT Zurueck
  162.     IF UCASE$(Lesenummer$)="E" THEN
  163.       Zurueck=-1
  164.     ELSE
  165.       IF Lesenummer$="" THEN
  166.         Lesenummer=Lesenummer
  167.       ELSE
  168.         Lesenummer=VAL(LEFT$(Lesenummer$,4))
  169.       END IF
  170.       CALL SetAPen& (rp&,0)
  171.       CALL RectFill& (rp&,0,16,640,30)
  172.       Ladenummer=Lesenummer : GOSUB Laden : Lesenummer=Ladenummer
  173.       IF Erfolg THEN
  174.         CALL SetAPen& (rp&,0)
  175.         CALL RectFill& (rp&,0,16,640,32)
  176.         Shadow  "Datensatznummer :  "+STR$(LOC(1)),1,2,3,27,rp&
  177.         FOR i=0 TO 4
  178.           j=i*2
  179.           CALL Move& (rp&,x(2)+4,y(j)+10)
  180.           CALL Text& (rp&,SADD(DatFeld$(i)+CHR$(0)),LEN(DatFeld$(i)))
  181.         NEXT
  182.         CALL Move& (rp&,x(2)+4,y(8)+19)
  183.         CALL Text& (rp&,SADD(DatFeld$(5)+CHR$(0)),LEN(DatFeld$(5)))
  184.         CALL Move& (rp&,x(2)+4,y(8)+28)
  185.         CALL Text& (rp&,SADD(DatFeld$(6)+CHR$(0)),LEN(DatFeld$(6)))
  186.         Lesenummer$=""
  187.         Taste CHR$(8)+CHR$(9)+CHR$(13)+CHR$(27)+CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),Antwort$
  188.         IF Antwort$=CHR$(30) THEN
  189.           Lesenummer=Lesenummer+1    'Cursor right
  190.         ELSEIF Antwort$=CHR$(31) THEN
  191.           Lesenummer=Lesenummer-1    'Cursor left
  192.         ELSEIF Antwort$=CHR$(29) THEN
  193.           Lesenummer=Lesenummer+10   'Cursor down
  194.         ELSEIF Antwort$=CHR$(28) THEN
  195.           Lesenummer=Lesenummer-10   'Cursor up
  196.         ELSEIF Antwort$=CHR$(9) THEN
  197.           Lesenummer=Feldzaehler-1   'TAB
  198.         ELSEIF Antwort$=CHR$(8) THEN
  199.           Lesenummer=1               'Backspace
  200.         ELSEIF Antwort$=CHR$(13) THEN
  201.           GOSUB Nummerneingabe       'Return
  202.           Lesenummer$=Nummer$
  203.         ELSE
  204.           Zurueck=-1                 'Escape
  205.         END IF
  206.       END IF
  207.       IF NOT Erfolg THEN Zurueck=-1
  208.     END IF
  209.   WEND
  210. RETURN
  211.  
  212. Aendern:
  213.   Zurueck=0
  214.   IF Lesenummer=0 THEN Lesenummer=1
  215.   WHILE NOT Zurueck
  216.     Geaendert=0
  217.     CALL SetAPen& (rp&,0)
  218.     CALL RectFill& (rp&,0,0,640,30)
  219.     CALL RectFill& (rp&,0,132,640,256)
  220.     Outline "AdressDat - Adressen ändern",1,0,-1,14,rp&
  221.     CALL SetAPen& (rp&,3)
  222.     CALL Move& (rp&,3,27)
  223.     CALL SetDrMd& (rp&,1)
  224.     Out$="Bitte Datensatznummer eingeben (0 für Ende) ---> "+CHR$(0)
  225.     CALL Text& (rp&,SADD(Out$),LEN(Out$)-1)
  226.     CALL SetAPen& (rp&,1)  
  227.     LINE INPUT Aendernummer$
  228.     IF Aendernummer$="0" THEN
  229.       Zurueck=-1
  230.     ELSE
  231.       IF Aendernummer$="" THEN
  232.         Aendernummer=Lesenummer
  233.         Lesenummer=Lesenummer+1
  234.       ELSE
  235.         Aendernummer=VAL(LEFT$(Aendernummer$,4))
  236.       END IF
  237.       CALL Move& (rp&,3,27)
  238.       CALL ClearEOL& (rp&)
  239.       Ladenummer=Aendernummer : GOSUB Laden
  240.       IF Erfolg THEN
  241.         Shadow "Datensatznummer :  "+STR$(LOC(1)),1,2,3,27,rp&
  242.         Shadow "Wenn Du in dem markierten Bereich etwas ändern willst,",1,2,3,140,rp&
  243.         Shadow "drücke «DELETE», sonst «RETURN» !",1,2,3,152,rp&
  244.         FOR i=0 TO 6
  245.           Daten$(i)=DatFeld$(i)
  246.         NEXT
  247.         FOR i=0 TO 4
  248.           j=i*2
  249.           CALL Move& (rp&,x(2)+4,y(j)+10)
  250.           CALL Text& (rp&,SADD(Daten$(i)+CHR$(0)),LEN(Daten$(i)))
  251.         NEXT
  252.         CALL Move& (rp&,x(2)+4,y(8)+19)
  253.         CALL Text& (rp&,SADD(Daten$(5)+CHR$(0)),LEN(Daten$(5)))
  254.         CALL Move& (rp&,x(2)+4,y(8)+28)
  255.         CALL Text& (rp&,SADD(Daten$(6)+CHR$(0)),LEN(Daten$(6)))
  256.         FOR i=0 TO 4
  257.           j=i*2
  258.           CALL SetDrMd& (rp&,2)
  259.           CALL RectFill& (rp&,x(2),y(j),x(3),y(j)+12)
  260.           CALL SetDrMd& (rp&,0)
  261.           Taste CHR$(13)+CHR$(127),Antwort$
  262.           CALL SetDrMd& (rp&,2)
  263.           CALL RectFill& (rp&,x(2),y(j),x(3),y(j)+12)
  264.           CALL SetDrMd& (rp&,0)
  265.           IF Antwort$=CHR$(127) THEN
  266.             CALL SetAPen& (rp&,0)
  267.             CALL RectFill& (rp&,0,132,640,256)
  268.             Shadow "Bitte den neuen Text eingeben",3,2,-1,140,rp&
  269.             Shadow "Zur Erinnerung : Der alte Text lautete",1,2,5,155,rp&
  270.             Shadow Daten$(i),1,2,5,166,rp&
  271.             CALL SetDrMd& (rp&,1)
  272.             CALL Move& (rp&,x(2)+4,y(j)+10)
  273.             CALL Text& (rp&,SADD(SPACE$(46)+CHR$(0)),46)
  274.             CALL SetAPen& (rp&,3)
  275.             xEdit Daten$(i),Laenge(i),x(2)+4,y(j)+10,rp&
  276.             Geaendert=-1
  277.             CALL SetAPen& (rp&,0)
  278.             CALL RectFill& (rp&,0,132,640,256)
  279.             Shadow "Wenn in dem markierten Bereich etwas ändern willst,",1,2,3,140,rp&
  280.             Shadow "drücke «DELETE», sonst «RETURN» !",1,2,3,152,rp&
  281.           END IF
  282.           IF i=4 THEN
  283.             CALL SetDrMd& (rp&,2)
  284.             CALL RectFill& (rp&,x(2),y(j)+12,x(3),y(j)+21)
  285.             CALL SetDrMd& (rp&,0)
  286.             Taste CHR$(13)+CHR$(127),Antwort$
  287.             CALL SetDrMd& (rp&,2)
  288.             CALL RectFill& (rp&,x(2),y(j)+12,x(3),y(j)+21)
  289.             CALL SetDrMd& (rp&,0)
  290.             IF Antwort$=CHR$(127) THEN
  291.               CALL SetAPen& (rp&,0)
  292.               CALL RectFill& (rp&,0,132,640,256)
  293.               Shadow "Bitte den neuen Text eingeben",3,2,-1,140,rp&
  294.               Shadow "Zur Erinnerung : Der alte Text lautete",1,2,5,155,rp&
  295.               Shadow Daten$(5),1,2,5,166,rp&
  296.               CALL SetAPen& (rp&,0)
  297.               CALL Move& (rp&,x(2)+4,y(j)+19)
  298.               CALL Text& (rp&,SADD(SPACE$(46)+CHR$(0)),46)
  299.               CALL SetAPen& (rp&,3)
  300.               xEdit Daten$(5),Laenge(5),x(2)+4,y(j)+19,rp&
  301.               Geaendert=-1
  302.               CALL SetAPen& (rp&,0)
  303.               CALL RectFill& (rp&,0,132,640,256)
  304.               Shadow "Wenn Du in dem markierten Bereich etwas ändern willst,",1,2,3,140,rp&
  305.               Shadow "drücke «DELETE» sonst «RETURN» !",1,2,3,152,rp&
  306.             END IF
  307.             CALL SetDrMd& (rp&,2)
  308.             CALL RectFill& (rp&,x(2),y(j)+21,x(3),y(j)+32)
  309.             CALL SetDrMd& (rp&,0)
  310.             Taste CHR$(13)+CHR$(127),Antwort$
  311.             CALL SetDrMd& (rp&,2)
  312.             CALL RectFill& (rp&,x(2),y(j)+21,x(3),y(j)+32)
  313.             CALL SetDrMd& (rp&,0)
  314.             IF Antwort$=CHR$(127) THEN
  315.               CALL SetAPen& (rp&,0)
  316.               CALL RectFill& (rp&,0,132,640,256)
  317.               Shadow "Bitte den neuen Text eingeben",3,2,-1,140,rp&
  318.               Shadow "Zur Erinnerung : Der alte Text lautete",1,2,5,155,rp&
  319.               Shadow Daten$(6),1,2,5,166,rp&
  320.               CALL SetDrMd& (rp&,1)
  321.               CALL Move& (rp&,x(2)+4,y(j)+28)
  322.               CALL Text& (rp&,SADD(SPACE$(46)+CHR$(0)),46)
  323.               CALL SetAPen& (rp&,3)
  324.               xEdit Daten$(6),Laenge(6),x(2)+4,y(j)+28,rp&
  325.               Geaendert=-1
  326.             END IF
  327.           END IF
  328.           CALL SetDrMd& (rp&,0)
  329.         NEXT
  330.         IF Geaendert THEN
  331.           CALL SetDrMd& (rp&,0)
  332.           CALL SetAPen& (rp&,0)
  333.           CALL RectFill& (rp&,0,132,640,256)
  334.           Shadow "Soll die Änderung abgespeichert werden (j/n) ?",1,2,-1,160,rp&
  335.           Taste "JN",Antwort$
  336.           IF Antwort$="J" THEN Speichernummer=Aendernummer : GOSUB Speichern
  337.         END IF
  338.       END IF
  339.       IF Erfolg=-1 THEN
  340.         Zurueck=-1
  341.       ELSE
  342.         CALL SetDrMd& (rp&,0)
  343.         CALL SetAPen& (rp&,0)
  344.         CALL RectFill& (rp&,0,132,640,256)
  345.         Shadow "Weitere Adressen ändern (j/n) ?",1,2,-1,160,rp&
  346.         Taste "JN",Antwort$
  347.         IF Antwort$="N" THEN Zurueck=-1
  348.       END IF
  349.     END IF
  350.   WEND
  351. RETURN
  352.  
  353. Suchen:
  354.   Zurueck=0
  355.   WHILE NOT Zurueck
  356.     CALL SetAPen& (rp&,0)
  357.     CALL RectFill& (rp&,0,0,640,30)
  358.     CALL RectFill& (rp&,0,132,640,256)
  359.     Outline "AdressDat - Adressen suchen",1,0,-1,14,rp&
  360.     CALL SetAPen& (rp&,3)
  361.     CALL Move& (rp&,3,27)
  362.     CALL SetDrMd& (rp&,1)
  363.     Out$="Ab welcher Datensatznummer suchen? (0 für Ende) ---> "+CHR$(0)
  364.     CALL Text& (rp&,SADD(Out$),LEN(Out$)-1)
  365.     CALL SetAPen& (rp&,1)  
  366.     LINE INPUT Suchnummer$
  367.     IF Suchnummer$="0" THEN 
  368.       Zurueck=-1
  369.     ELSE
  370.       Suchnummer=VAL(Suchnummer$)
  371.       IF Suchnummer$="" THEN Suchnummer=1
  372.       Ladenummer=Suchnummer : GOSUB Laden
  373.       IF Erfolg THEN
  374.         Shadow "Wenn Du in dem markierten Bereich etwas suchen willst,",1,2,3,140,rp&
  375.         Shadow "drücke «HELP» sonst «RETURN»,",1,2,3,152,rp&
  376.         Shadow "oder «G» für Suche in allen Bereichen !",1,2,3,164,rp&      
  377.         Suchen =-3             ' Muß auf Wert <0 zurckgesetzt werden
  378.         FOR i=0 TO 4
  379.           j=i*2
  380.           CALL SetDrMd& (rp&,2)
  381.           CALL RectFill& (rp&,x(2),y(j),x(3),y(j+1))
  382.           CALL SetDrMd& (rp&,0)
  383.           Taste CHR$(13)+CHR$(139)+"G",Antwort$
  384.           CALL SetDrMd& (rp&,2)
  385.           CALL RectFill& (rp&,x(2),y(j),x(3),y(j+1))
  386.           CALL SetDrMd& (rp&,0)
  387.           IF Antwort$=CHR$(139) OR Antwort$="G" THEN
  388.             CALL SetAPen& (rp&,0)
  389.             CALL RectFill& (rp&,0,132,640,256)
  390.             Shadow "Bitte den Suchbegriff eingeben",3,2,-1,140,rp&
  391.             CALL SetDrMd& (rp&,1)
  392.             CALL Move& (rp&,x(2)+4,y(j)+10)
  393.             CALL Text& (rp&,SADD(SPACE$(46)+CHR$(0)),46)
  394.             CALL SetAPen& (rp&,3)
  395.             xEdit Suchstring$,Laenge(i),x(2)+4,y(j)+10,rp&
  396.             Dummy$=Suchstring$
  397.             UpperCase Dummy$,Suchstring$
  398.             IF Antwort$="G" THEN Suchen=5 ELSE Suchen=i
  399.             i=5 ' Damit die FOR-NEXT-Schleife verlassen wird
  400.           END IF
  401.           CALL SetDrMd& (rp&,0)
  402.         NEXT
  403.         IF Suchen >=0 THEN
  404.           FOR i=Suchnummer TO Feldzaehler-1
  405.             Gefunden=0 : Lesenummer=i 'Damit Satz ohne Nummerneingabe geän-
  406.             CALL SetAPen& (rp&,0)     'dert werden kann (siehe Teil "Aendern")
  407.             CALL RectFill& (rp&,0,132,640,256)
  408.             Shadow "Ich suche ...",1,2,-1,140,rp&
  409.             Ladenummer=i : GOSUB Laden
  410.             Durchsuch$=DatFeld$(Suchen)
  411.             IF Suchen=4 THEN Durchsuch$=DatFeld$(4)+DatFeld$(5)+DatFeld$(6)
  412.             IF Suchen=5 THEN Durchsuch$=DatFeld$(0)+DatFeld$(1)+DatFeld$(2)+DatFeld$(3)+DatFeld$(4)+DatFeld$(5)+DatFeld$(6)
  413.             Dummy$=Durchsuch$
  414.             UpperCase Dummy$,Durchsuch$
  415.             Enthalten=INSTR(Durchsuch$,Suchstring$)
  416.             IF Enthalten <>0 THEN
  417.               Gefunden=-1
  418.               CALL Move& (rp&,3,27)
  419.               CALL ClearEOL& (rp&)
  420.               Shadow "Datensatznummer : "+STR$(i),1,2,3,27,rp&
  421.               FOR k=0 TO 4
  422.                 j=k*2
  423.                 CALL Move& (rp&,x(2)+4,y(j)+10)
  424.                 CALL Text& (rp&,SADD(DatFeld$(k)+CHR$(0)),LEN(DatFeld$(k)))
  425.               NEXT
  426.               CALL Move& (rp&,x(2)+4,y(8)+19)
  427.               CALL Text& (rp&,SADD(DatFeld$(5)+CHR$(0)),LEN(DatFeld$(5)))
  428.               CALL Move& (rp&,x(2)+4,y(8)+28)
  429.               CALL Text& (rp&,SADD(DatFeld$(6)+CHR$(0)),LEN(DatFeld$(6)))
  430.               CALL SetAPen& (rp&,0)
  431.               CALL RectFill& (rp&,0,132,640,256)
  432.               Shadow "Weiter suchen (j/n) ?",1,2,-1,140,rp&
  433.               Taste "JN",Antwort$
  434.               IF Antwort$="N" THEN i=Feldzaehler ' Schleife verlassen
  435.             END IF
  436.           NEXT
  437.           IF NOT Gefunden THEN
  438.             CALL SetAPen& (rp&,0)
  439.             CALL RectFill& (rp&,0,132,640,256)
  440.             Shadow "Suchbegriff nicht gefunden",3,2,-1,140,rp&
  441.             Outline "Taste ...",3,0,-1,160,rp&
  442.             WHILE INKEY$="" : SLEEP : WEND
  443.           END IF
  444.         END IF
  445.       END IF
  446.       CALL SetAPen& (rp&,0)
  447.       CALL RectFill& (rp&,0,132,640,256)
  448.       Shadow "Weitere Adressen suchen (j/n) ?",1,2,-1,140,rp&
  449.       Taste "JN",Antwort$
  450.       IF Antwort$="N" THEN Zurueck=-1
  451.     END IF
  452.   WEND
  453. RETURN
  454.  
  455. Speichern:
  456.   FOR i=0 TO 6
  457.     LSET DatFeld$(i)=Daten$(i)+SPACE$(45)
  458.   NEXT
  459.   PUT #1,Speichernummer
  460. RETURN
  461.  
  462. Laden:
  463.   IF Ladenummer <1 OR Ladenummer > Feldzaehler-1 THEN
  464.     IF Ladenummer <1 THEN
  465.       Ladenummer=1
  466.     ELSE
  467.       Ladenummer=Feldzaehler-1
  468.     END IF
  469.   END IF
  470.   IF Feldzaehler=1 THEN
  471.     BEEP
  472.     CALL SetAPen& (rp&,0)
  473.     CALL SetDrMd& (rp&,0)
  474.     CALL RectFill& (rp&,0,0,640,30)
  475.     CALL RectFill& (rp&,0,132,640,246)
  476.     Outline "KEINE DATEI VORHANDEN !",1,0,-1,14,rp&
  477.     Shadow "Mit «E» neue Adreßdatei erstellen",1,2,-1,142,rp&
  478.     Shadow "Taste ...",3,2,-1,178,rp&
  479.     WHILE INKEY$="" : SLEEP : WEND
  480.     Erfolg=0
  481.   ELSE
  482.     GET #1,Ladenummer
  483.     Erfolg=-1
  484.   END IF
  485. RETURN
  486.  
  487. Quit:
  488.   CALL SetAPen& (rp&,0)
  489.   CALL RectFill& (rp&,0,0,640,30)
  490.   CALL RectFill& (rp&,0,132,640,256)
  491.   Outline "AdressDat - Beenden",1,0,-1,14,rp&
  492.   Shadow  "Soll das Programm wirklich beendet werden (j/n) ?",1,2,-1,160,rp&
  493.   Taste "JN",Antwort$
  494.   IF Antwort$="J" THEN Aus=-1
  495. RETURN
  496.   
  497. Nummerneingabe:
  498.   CALL SetAPen& (rp&,0)
  499.   CALL RectFill& (rp&,0,16,640,30)
  500.   CALL Move& (rp&,3,27)
  501.   CALL SetAPen& (rp&,3)
  502.   CALL SetDrMd& (rp&,1)
  503.   Out$="Bitte Datensatznummer eingeben («e» für Ende) ---> "+CHR$(0)
  504.   CALL Text& (rp&,SADD(Out$),LEN(Out$)-1)
  505.   CALL SetAPen& (rp&,1)  
  506.   LINE INPUT Nummer$
  507. RETURN
  508.  
  509. Zeit:
  510.   TIMER OFF
  511.   Zeit$=TIME$
  512.   sekunden=VAL(RIGHT$(Zeit$,1))
  513.   CALL SetWindowTitles& (wptr&,SADD(WindowTitle$+Zeit$+CHR$(0)),-1)
  514.   ON TIMER (10-sekunden) GOSUB Zeit
  515.   TIMER ON
  516. RETURN
  517.  
  518.  MaskeX:
  519.   DATA 19,112,118,602
  520.  MaskeY:
  521.   DATA 34,45,50,62,66,78,82,94,98,130
  522.  Namen:
  523.   DATA Name,Straße,Ort,Telefon,Bemerkungen 
  524.  Laengen:
  525.   DATA 30,30,20,12,45,45,45
  526.    
  527. SUB Shadow (Shadow$,a%,b%,x%,y%,rp&) STATIC
  528.   LET Shadow%=LEN(Shadow$)
  529.   IF x%=-1 THEN x%=309-Shadow%*4  'Wenn fÜr x -1 angegeben, dann zentrieren
  530.   LET Shadow$=Shadow$+CHR$(0)
  531.   CALL SetDrMd& (rp&,0)
  532.   CALL SetAPen& (rp&,b%)
  533.   CALL Move& (rp&,x%+2,y%+2)
  534.   CALL Text& (rp&,SADD(Shadow$),Shadow%)
  535.   CALL SetAPen& (rp&,a%)
  536.   CALL Move& (rp&,x%,y%)
  537.   CALL Text& (rp&,SADD(Shadow$),Shadow%)
  538.   CALL SetDrMd& (rp&,1)
  539. END SUB
  540.  
  541. SUB Outline (Outline$,a%,b%,x%,y%,rp&) STATIC
  542.   LET Outline%=LEN(Outline$)
  543.   IF x%=-1 THEN x%=306-Outline%*4  'Wenn fÜr x -1 angegeben, dann zentrieren
  544.   LET Outline$=Outline$+CHR$(0)
  545.   CALL SetDrMd& (rp&,0)
  546.   CALL SetAPen& (rp&,a%)
  547.   FOR i%=x%-1 TO x%+1
  548.     FOR j%=y%-1 TO y%+1
  549.       CALL Move& (rp&,i%,j%)
  550.       CALL Text& (rp&,SADD(Outline$),Outline%)
  551.     NEXT
  552.   NEXT
  553.   CALL SetAPen& (rp&,b%)
  554.   CALL Move& (rp&,x%,y%)
  555.   CALL Text& (rp&,SADD(Outline$),Outline%)
  556.   CALL SetAPen& (rp&,a%)
  557. END SUB
  558.  
  559. SUB Taste (Ein$,Aus$) STATIC
  560.   Ein$=UCASE$(Ein$) : Enthalten=0
  561.   WHILE Enthalten=0
  562.     Aus$=""
  563.     WHILE Aus$=""
  564.       Aus$=UCASE$(INKEY$)
  565.       SLEEP
  566.     WEND
  567.     Enthalten=INSTR (Ein$,Aus$)
  568.   WEND
  569. END SUB
  570.  
  571. SUB UpperCase (Ein$,Aus$) STATIC
  572.   Aus$=""
  573.   FOR i=1 TO LEN(Ein$)
  574.     Pruef=ASC(MID$(Ein$,i,1))
  575.     IF Pruef >=97 AND Pruef<=122 THEN
  576.       Aus$=Aus$+CHR$(Pruef-32)
  577.     ELSEIF Pruef >=224 AND Pruef <=246 THEN
  578.       Aus$=Aus$+CHR$(Pruef-32)
  579.     ELSEIF Pruef >=248 AND Pruef <=254 THEN
  580.       Aus$=Aus$+CHR$(Pruef-32)
  581.     ELSEIF Pruef=223 THEN
  582.       Aus$=Aus$+"SS"
  583.     ELSE
  584.       Aus$=Aus$+CHR$(Pruef)
  585.     END IF
  586.   NEXT
  587. END SUB
  588.  
  589. SUB xEdit (Ausgabe$,Stellen%,x%,y%,rp&) STATIC
  590.   a$="" : Ausgabe$=""
  591.   WHILE a$ <> CHR$(13)
  592.     a$=""
  593.     WHILE a$="" : a$=INKEY$ : WEND
  594.     a=ASC(a$)
  595.     IF ((a>=32 AND a<=126) OR (a>=161)) AND (LEN(Ausgabe$)<=Stellen%) THEN
  596.       Ausgabe$=Ausgabe$+a$
  597.     END IF
  598.     IF a=8 THEN
  599.       IF LEN(Ausgabe$)>0 THEN Ausgabe$=LEFT$(Ausgabe$,LEN(Ausgabe$)-1)
  600.     END IF
  601.     IF a=127 THEN Ausgabe$=""
  602.     Textausgabe&=SADD(Ausgabe$+SPACE$(Stellen%-LEN(Ausgabe$)+1)+CHR$(0))
  603.     CALL Move& (rp&,x%,y%)
  604.     CALL Text& (rp&,Textausgabe&,Stellen%)
  605.   WEND
  606. END SUB
  607.